{-
 This file is part of the Clafer to Alloy Translator (clafer2alloy).

 Copyright (C) 2010 Kacper Bak <http://gsd.uwaterloo.ca/kbak>

 clafer2alloy is free software: you can redistribute it and/or modify
 it under the terms of the GNU Lesser General Public License as published by
 the Free Software Foundation, either version 3 of the License, or
 (at your option) any later version.

 clafer2alloy is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU Lesser General Public License for more details.

 You should have received a copy of the GNU Lesser General Public License
 along with clafer2alloy. (See files COPYING and COPYING.LESSER.)  If not,
 see <http://www.gnu.org/licenses/>.
-}
-- IMPORTANT: super quick & dirty solution
module Ecoreclafer2alloy where

import Absclafer2alloy
import Common
import Data.Char

tag name exp = concat ["<", name, ">", exp, "</", name, ">"]

mkBool cond = (if cond then "true" else "false") ++ "\""

mkClassifier decls name isAbstract eSuperType content = concat
  [ decls
  , "<eClassifiers xsi:type=\"ecore:EClass\" name=\""
  , name ++ "\""
  , " abstract=\"" ++ mkBool isAbstract
  , if null eSuperType then "" else " eSuperTypes=\"" ++ eSuperType ++ "\""
  , " >\n"
  , content
  , "</eClassifiers>\n"]

mkStructuralFeature fType name card eType isContained = concat
  [ "<eStructuralFeatures xsi:type=\"ecore:"
  , fType ++ "\""
  , " name=\"" ++ name ++ "\""
  , " ordered=\"false\""
  , card
  , " eType=\"" ++ eType ++ "\""
  , " containment=\"" ++ mkBool isContained
  , " />\n"]

clafer2ecore mod = putStrLn $ clafer2ecoreModule mod

clafer2ecoreModule :: Module -> Result
clafer2ecoreModule x = case x of
  Module declarations  -> concat
    [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
    , "<xmi:XMI xmi:version=\"2.0\" xmlns:xmi=\"http://www.omg.org/XMI\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xmlns:ecore=\"http://www.eclipse.org/emf/2002/Ecore\">"
    , "<ecore:EPackage name=\"PrimitiveTypes\">"
    , "<eClassifiers xsi:type=\"ecore:EDataType\" name=\"Integer\"/>"
    , "<eClassifiers xsi:type=\"ecore:EDataType\" name=\"String\"/>"
    , "</ecore:EPackage>"
    , "<ecore:EPackage name=\"ClaferModel\">"
    , declarations >>= clafer2ecoreDeclaration
    , "</ecore:EPackage></xmi:XMI>"]
   
clafer2ecoreDeclaration :: Declaration -> Result
clafer2ecoreDeclaration x = case x of
  EnumDecl id enumids  -> error "desugared"
  AbsClaferDecl _ ident super _ elements  -> 
      mkClassifier (clafer2ecoreElements declElement elements)
                   (clafer2ecoreIdent ident)
                   True
                   (clafer2ecoreSuper super)
                   (clafer2ecoreElements addElement elements)
  ClaferDecl clafer -> clafer2ecoreClafer clafer
  ConstDecl constraint  -> "" -- constraints are not translated

clafer2ecoreConstraint :: Constraint -> Result
clafer2ecoreConstraint x = case x of
  Constraint essential lexps  -> error "const not implemented"

clafer2ecoreClafer :: Clafer -> Result
clafer2ecoreClafer x = case x of
  Clafer _ ident super attr _ card elements  -> 
      if isSuperPrimitive super || isReference x then "" else
         mkClassifier (clafer2ecoreElements declElement elements)
                      name
                      False
                      (clafer2ecoreSuper super)
                      (clafer2ecoreElements addElement elements)
         where
         name = drop (if hasSuper super then 3 else 0) $ clafer2ecoreSuper super ++ clafer2ecoreIdent ident

clafer2ecoreElements f x = case x of
  ElementsEmpty  -> error "desugared"
  Elements elements  -> elements >>= f

declElement :: Element -> Result
declElement x = case x of
  Subclafer clafer  -> clafer2ecoreClafer clafer
  ClaferUse name essential card elements -> error "desugared"
  Subconstraint constraint  -> ""


addElement :: Element -> Result
addElement x = case x of
  Subclafer clafer  -> addClafer clafer
  ClaferUse name essential card elements -> error "desugared"
  Subconstraint constraint  -> ""

addClafer x = case x of
  Clafer _ ident super attr _ card elements ->
    mkStructuralFeature "EReference"
                        (clafer2ecoreIdent ident)
                        (clafer2ecoreCard card)
                        (if isReference x
                            then clafer2ecoreAttr attr
                            else clafer2ecoreSuper super ++ sp ++ name)
                        (isReference x)
    where
    name = if isSuperPrimitive super then "" else clafer2ecoreIdent ident
    sp = if hasSuper super then "" else "/1/"

clafer2ecoreEssential :: Essential -> Result
clafer2ecoreEssential x = case x of
  EssentialEmpty  -> error "not implemented"
  Essential  -> error "not implemented"

clafer2ecoreSuper :: Super -> Result
clafer2ecoreSuper x = case x of
  SuperEmpty  -> error "desugared"
  Super name  -> clafer2ecoreName name

getSuperName :: Super -> Result
getSuperName x = case x of
  SuperEmpty  -> error "desugared"
  Super name  -> getNameId name

isSuperPrimitive x = case x of
  SuperEmpty  -> error "desugared"
  Super name  -> isNamePrimitive name

hasSuper x = case x of
  SuperEmpty  -> error "desugared"
  Super (Name _ id)  -> "clafer" /= clafer2ecoreIdent id

clafer2ecoreAttr :: Attr -> Result
clafer2ecoreAttr x = case x of
  AttrEmpty  -> error "not implemented"
  AttrSExp modids sexp  -> clafer2ecoreSExp sexp
  AttrSuper modids sexp -> clafer2ecoreSExp sexp

clafer2ecoreCard :: Card -> Result
clafer2ecoreCard x = case x of
  CardEmpty  -> error "desugared"
  CardLone  -> error "desugared"
  CardSome  -> error "desugared"
  CardAny  -> error "desugared"
  CardInterval (NCard m n)  -> concat
    [ " lowerBound=\"" ++ clafer2ecoreInteger m ++ "\""
    , " upperBound=\"" ++ clafer2ecoreExInteger n ++ "\""]

clafer2ecoreInteger :: Integer -> Result
clafer2ecoreInteger = show

clafer2ecoreExInteger :: ExInteger -> Result
clafer2ecoreExInteger x = case x of
  ExIntegerAst  -> show $ -1
  ExIntegerNum n  -> clafer2ecoreInteger n

clafer2ecoreSExp :: SExp -> Result
clafer2ecoreSExp x = case x of
  SExpUnion sexp0 sexp -> error "not implemented"
  SExpIntersection sexp0 sexp  -> error "not implemented"
  SExpDomain sexp0 sexp  -> error "not implemented"
  SExpRange sexp0 sexp  -> error "not implemented"
  SExpJoin sexp0 sexp  -> error "not implemented"
  SExpArrow sexp0 sexp  -> error "not implemented"
  SExpRIdent ident b -> clafer2ecoreSuperIdent ident

clafer2ecoreLExp :: LExp -> Result
clafer2ecoreLExp x = error "not implemented"

clafer2ecoreTerm :: Term -> Result
clafer2ecoreTerm x = error "not implemented"

clafer2ecoreCmpExp :: CmpExp -> Result
clafer2ecoreCmpExp x = error "not implemented"

clafer2ecoreExp :: Exp -> Result
clafer2ecoreExp x = case x of
  ESetExp sexp  -> error "not implemented"
  ENumExp aexp -> error "not implemented"
  EStrExp strexp -> error "analyzed"


clafer2ecoreQuant :: Quant -> Result
clafer2ecoreQuant x = case x of
  QuantNo   -> error "not implemented"
  QuantLone -> error "not implemented"
  QuantOne  -> error "not implemented"
  QuantSome -> error "not implemented"


clafer2ecoreExQuant :: ExQuant -> Result
clafer2ecoreExQuant x = case x of
  ExQuantAll -> error "not implemented"
  ExQuant quant -> error "not implemented"


clafer2ecoreDecl :: Decl -> Result
clafer2ecoreDecl x = case x of
  Decl exquant disj locids sexp -> error "not implemented"

clafer2ecoreDisj :: Disj -> Result
clafer2ecoreDisj x = case x of
  DisjEmpty -> error "not implemented"
  Disj -> error "not implemented"

clafer2ecoreLocId :: LocId -> Result
clafer2ecoreLocId x = case x of
   LocIdIdent ident -> error "not implemented"


clafer2ecoreAExp :: AExp -> Result
clafer2ecoreAExp x = error "not implemented"

clafer2ecoreIdent :: Ident -> Result
clafer2ecoreIdent x = case x of
  Ident ('@':str) -> str
  Ident str  -> str


clafer2ecoreName :: Name -> Result
clafer2ecoreName x = case x of
  Name modids id  -> clafer2ecoreSuperIdent id

clafer2ecoreSuperIdent id = if isIdentPrimitive id
                        then "/0/" ++ capWord str
                        else if str == "clafer" then ""
                        else "/1/" ++ str
  where
  str = clafer2ecoreIdent id

isNamePrimitive :: Name -> Bool
isNamePrimitive x = case x of
  Name modids id  -> isIdentPrimitive id

isIdentPrimitive id = clafer2ecoreIdent id `elem` ["integer", "string"]


capWord []     = []
capWord (x:xs) = toUpper x : xs

getNameId (Name _ id) = clafer2ecoreIdent id